home *** CD-ROM | disk | FTP | other *** search
/ CD ROM Paradise Collection 4 / CD ROM Paradise Collection 4 1995 Nov.iso / os2 / adaptor.zip / ADAPT.ZIP / adaptor / examples / dalib / overlap / test2.f < prev    next >
Text File  |  1993-04-27  |  1KB  |  79 lines
  1.       program overlap_test
  2.  
  3.       parameter (n=30)
  4.  
  5.       real a(n, n)
  6.       call cmf_random (a)
  7.       call test_leftup1 (a,n)
  8.       call test_rightdown2 (a,n)
  9.       end
  10.  
  11.       subroutine test_leftup1 (a, n)
  12.  
  13.       integer n
  14.  
  15.       real a(n,n), b(n[1:0],n[1:0])   
  16.       real a1(n,n)
  17.       logical equal (n,n)
  18.       integer errors
  19.  
  20. c     call print_a (a, n)
  21.  
  22.       b = a
  23.       forall (i=1:n,j=1:n)
  24.          a1 (j,i) = b (j-1,i-1)
  25.       end forall
  26. c     call print_a (a1, n)
  27.  
  28.  
  29.       a = cshift (a, 1, -1)
  30.       a = cshift (a, 2, -1)
  31. c     call print_a (a, n)
  32.  
  33.       equal = (a1 .eq. a)
  34.       errors = count (equal)
  35.       errors = n*n - errors
  36.  
  37.       print *, errors, ' Errors for left overlapping'
  38.       end
  39.  
  40.       subroutine test_rightdown2 (a, n)
  41.  
  42.       integer n
  43.  
  44.       real a(n,n), b(n[0:2],n[0:3])   
  45.       real a1(n,n)
  46.       logical equal (n,n)
  47.       integer errors
  48.  
  49. c     call print_a (a, n)
  50.  
  51.       b = a
  52.       forall (i=1:n,j=1:n)
  53.          a1 (j,i) = b (j+2,i+3)
  54.       end forall
  55. c     call print_a (a1, n)
  56.  
  57.  
  58.       a = cshift (a, 1, 2)
  59.       a = cshift (a, 2, 3)
  60. c     call print_a (a, n)
  61.  
  62.       equal = (a1 .eq. a)
  63.       errors = count (equal)
  64.       errors = n*n - errors
  65.  
  66.       print *, errors, ' Errors for right overlapping'
  67.       end
  68.  
  69.       subroutine print_a (a, n)
  70.       real a(n,n)
  71.       integer i, j, n
  72.       do i = 1, n
  73.          do j = 1, n
  74.             print *, 'a(',i,',',j,') = ', a(i,j)
  75.          end do
  76.       end do
  77.       end
  78.  
  79.